;; e2.54
;; (equal? '(this is a list) '(this is a list)) ;#t
;; (equal? '(this is a list) '(this (is a) list)) ;#f


;; e2.55
;; (car ''avsdsa)

;; e2.56
(define (deriv exp var)
  (cond ((number? exp) 0)
	((variable? exp)
	 (if (same-variable? exp var) 1 0))
	((sum? exp)
	 (make-sum (deriv (addend exp) var)
		   (deriv (augend exp) var)))
	((product? exp)
	 (make-sum
	  (make-product (multiplier exp)
			(deriv (multiplicand exp) var))
	  (make-product (multiplicand exp)
			(deriv (multiplier exp) var))))
	((exponentiation? exp)
	 (make-product (make-product (exponent exp) (deriv (base exp) var))
		       (make-exponentiation (base exp) (- (exponent exp) 1))))
	(else (error "unkown expression type -- DERIV" exp))))
(define (variable? x) (symbol? x))
(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))
;  (define (make-sum a1 a2) (list '+ a1 a2))
;  (define (make-product m1 m2) (list '* m1 m2))
(define (sum? x) (and (pair? x) (eq? (car x) '+)))
(define (addend s) (cadr s))
(define (augend s) (caddr s))
(define (product? x) (and (pair? x) (eq? (car x) '*)))
(define (multiplier p) (cadr p))
(define (multiplicand p) (caddr p))
(define (make-sum a1 a2)
  (cond ((=number? a1 0) a2)
	((=number? a2 0) a1)
	((and (number? a1) (number? a2) (+ a1 a2)))
	(else (list '+ a1 a2))))
(define (=number? exp num) (and (number? exp) (= exp num)))
(define (make-product m1 m2)
  (cond ((or (=number? m1 0) (=number? m2 0)) 0)
	((=number? m1 1) m2)
	((=number? m2 1) m1)
	(else (list '* m1 m2))))
(define (exponentiation? e) (and (pair? e) (eq? (car e) '^)))
(define (base e) (cadr e))
(define (exponent e) (caddr e))
(define (make-exponentiation base exponent)
  (cond ((=number? exponent 0) 1)
	((=number? exponent 1) base)
	(else (list '^ base exponent))))

;; (deriv '(+ x 3) 'x)
;; (deriv '(* x y) 'x)
;; (deriv '(* (* x y) (+ x 3)) 'x)
;; (deriv '(^ x 3) 'x)

;; e2.57
(define (augend s) (if (null? (cdddr s)) (caddr s) (cons '+ (cddr s))))
(define (multiplicand s)  (if (null? (cdddr s)) (caddr s) (cons '* (cddr s))))

;; (augend '(+ x y z))
;; (augend '(+ x y))
;; (multiplicand '(* (+ x y) (* z z) w))
;; (multiplicand '(* (+ x y) (* z z)))
;; (deriv '(* (+ x y) (* z z) w) 'x)
;; (deriv '(* (+ x y) (* z z) w) 'w)
;; (deriv '(* (+ x y) (* z z) w) 'z)
;; (deriv '(* (+ x y) (* z z)) 'z)
;;
;;
;; e2.58
;; a)
;;
;;
;; 2.3.3实例：集合的表示
;; 集合作为未排序的表
(define (element-of-set? x set)
  (cond ((null? set) false)
	((equal? x (car set)) true)
	(else (element-of-set? x (cdr set)))))
(define (adjoin-set x set)
  (if (element-of-set? x set)
      set
      (cons x set)))
(define (intersection-set set1 set2)
  (cond ((or (null? set1) (null? set2)) '())
	((element-of-set? (car set1) set2)
	 (cons (car set1)
	       (intersection-set (cdr set1) set2)))
	(else (intersection-set (cdr set1) set2))))

;;
;; e2.59
(define (union-set set1 set2)
  (cond ((null? set1) set2)
	((element-of-set? (car set1) set2)
	 (union-set (cdr set1) set2))
	(else (cons (car set1) (union-set (cdr set1) set2)))))
;;(union-set '(a b c) '(a d e))
;;      
;; e.2.60 集合有重复元素
;; 修改adjoin即可
;;
;;
;; 集合作为排序的表
(define (element-of-set? x set)
  (cond ((null? set) false)
	((= x (car set)) true)
	((< x (car set)) false)
	((> x (car set)) (element-of-set? x (cdr set)))))
;; (element-of-set? 'd '(a c e g))
;; (element-of-set? 2 (list 1 3 5 7))
;; (element-of-set? 7 (list 1 3 5 7))
(define (intersection-set set1 set2)
  (if (or (null? set1) (null? set2))
      '()
      (let ((x1 (car set1)) (x2 (car set2)))
	(cond ((= x1 x2)
	       (cons x1 (intersection-set (cdr set1) (cdr set2))))
	      ((< x1 x2) (intersection-set (cdr set1) set2))
	      ((< x2 x1) (intersection-set set1 (cdr set2)))))))
;;
;; e2.61
;;
(define (adjoin-set x set)
  (cond ((null? set) (list x))
	((= x (car set)) set)
	((< x (car set)) (cons x set))
	((> x (car set)) (cons (car set) (adjoin-set x (cdr set))))))
;; (adjoin-set 2 (list 2))
;; (adjoin-set 2 (list 1 3 5))
;; (adjoin-set 2 (list))
;; 
;; e2.62 union-set的O(n)实现
(define (union-set set1 set2)
  (cond ((null? set1) set2)
	((null? set2) set1)
	(else 
	 (let ((x1 (car set1)) (x2 (car set2)))
	  (cond ((= x1 x2) (cons x1 (union-set (cdr set1) (cdr set2))))
		((< x1 x2) (cons x1 (cons x2 (union-set (cdr set1) (cdr set2)))))
		((< x2 x1) (cons x2 (cons x1 (union-set (cdr set1) (cdr set2))))))))))
;; (union-set (list 1 3) (list 2 4))
;;
;; 集合作为二叉树
;;
(define (entry tree) (car tree))
(define (left-branch tree) (cadr tree))
(define (right-branch tree) (caddr tree))
(define (make-tree entry left right) (list entry left right))
(define (element-of-set? x set)
  (cond ((null? set) false)
	((= x (car set)) true)
	((< x (car set)) (element-of-set? x (left-branch set)))
	((> x (car set)) (element-of-set? x (right-branch set)))))
(define (adjoin-set x set)
  (cond ((null? set) (make-tree x '() '()))
	((= x (car set)) set)
	((< x (car set))
	 (make-tree (entry set)
		    (adjoin-set x (left-branch set))
		    (right-branch set)))
	((> x (car set))
	 (make-tree (entry set)
		    (left-branch set)
		    (adjoin-set x (right-branch set))))))
;; (adjoin-set 1 '())
;;
;; e2.63
(load "base.scm")
(define (make-tree-from-list list)
  (accumulate adjoin-set '() (reverse list))) 
;; (define tree-2-16-1 (make-tree-from-list (list 7 3 9 1 5 11)))
;; (define tree-2-16-2 (make-tree-from-list (list 3 1 7 5 9 11)))
;; (define tree-2-16-3 (make-tree-from-list (list 5 3 9 1 7 11)))
;; (define tree-2-17 (make-tree-from-list (enumerate-interval 1 7)))
(define (tree->list-1 tree)
  (if (null? tree)
      '()
      (append (tree->list-1 (left-branch tree))
	      (cons (entry tree)
		    (tree->list-1 (right-branch tree))))))
;; (tree->list-1 tree-2-16-1)
;; (tree->list-1 tree-2-16-2)
;; (tree->list-1 tree-2-16-3)
;; (tree->list-1 tree-2-17)
(define (tree->list-2 tree)
  (define (copy-to-list tree result-list)
    (if (null? tree)
	result-list
	(copy-to-list (left-branch tree)
		      (cons (entry tree)
			    (copy-to-list (right-branch tree) 
					  result-list)))))
  (copy-to-list tree '()))
;; (tree->list-2 tree-2-16-1)
;; (tree->list-2 tree-2-16-2)
;; (tree->list-2 tree-2-16-3)
;; (tree->list-2 tree-2-17)
;;
;; e2.64
;; e2.65
;; e2.66 略
;;
;;
;; Huffman树
;;
(define (make-leaf symbol weight)
  (list 'leaf (list symbol) weight))
(define (leaf? object) (eq? 'leaf (car object)))
(define (symbol-leaf x) (cadr x))
(define (weight-leaf x) (caddr x))
(define (make-code-tree left right)
  (list left 
	right
	(append (symbol left) (symbol right))
	(+ (weight left) (weight right))))
(define (left-branch tree) (car tree))
(define (right-branch tree) (cadr tree))
(define (symbols tree) (if (leaf? tree) (symbol-leaf tree) (caddr tree)))
(define (weight tree) (if (leaf? tree) (weight-leaf tree) (cadddr tree)))
(define (decode bits tree)
  (define (decode-1 bits  current-branch)
    (if (null? bits)
	'()
	(let ((next-branch (choose-branch (car bits) current-branch)))
	  (if (leaf? next-branch)
	      (cons (car (symbol-leaf next-branch))
		    (decode-1 (cdr bits) tree))
	      (decode-1 (cdr bits) next-branch))))) 
  (decode-1 bits tree))
(define (choose-branch bit branch)
  (cond ((= bit 0) (left-branch branch))
	((= bit 1) (right-branch branch))
	(else (error "bad bit -- CHOOSE-BRANCH" bit))))
(define (adjoin-set x set)
  (cond ((null? set) (list x))
	((< (weight x) (weight (car set))) (cons x set))
	(else (cons (car set)
		    (adjoin-set x (cdr set))))))
(define (make-leaf-set pairs)
  (if (null? pairs)
      '()
      (let ((pair (car pairs)))
	(adjoin-set (make-leaf (car pair)
			       (cadr pair))
		    (make-leaf-set (cdr pairs))))))
;; e2.67
(define sample-tree
  (make-code-tree (make-leaf 'A 4)
		  (make-code-tree
		   (make-leaf 'B 2)
		   (make-code-tree (make-leaf 'D 1)
				   (make-leaf 'C 1)))))
(define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))
(define words (decode sample-message sample-tree))
;;
;; e2.68
(define (encode message tree)
  (if (null? message)
      '()
      (append (encode-symbol (car message) tree)
	      (encode (cdr message) tree))))
(define (encode-symbol symbol tree)
  (cond ((or (null? tree) (leaf? tree)) '())
	((memq symbol (symbols (left-branch tree)))
	 (cons 0 (encode-symbol symbol (left-branch tree))))
	((memq symbol (symbols (right-branch tree)))
	 (cons 1 (encode-symbol symbol (right-branch tree))))
	(else (error "wrong tree -- ENCODE-SYMBOL" tree))))
;; (encode-symbol 'D sample-tree)
;; (encode words sample-tree)
;; 
;; e2.69
(define (generate-huffman-tree pairs)
  (define (generate node-set)
    (if (= 1 (length node-set))
	(car node-set)
	(generate (adjoin-set (make-code-tree (car node-set)
					      (cadr node-set))
			      (cddr node-set)))))
  (generate (make-leaf-set pairs)))
;; (define pairs '( (A 4) (B 2) (D 1) (C 1)))
;; (generate-huffman-tree pairs)



	
